home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / runtime / floats.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-24  |  2.5 KB  |  145 lines  |  [TEXT/MPS ]
  1. #include <math.h>
  2. #include <stdio.h>
  3. #include "alloc.h"
  4. #include "fail.h"
  5. #include "memory.h"
  6. #include "debugger.h"
  7. #include "mlvalues.h"
  8.  
  9. #ifdef ALIGN_DOUBLE
  10.  
  11. double Double_val(val)
  12.      value val;
  13. {
  14.   union { value v[2]; double d; } buffer;
  15.  
  16.   Assert(sizeof(double) == 2 * sizeof(value));
  17.   buffer.v[0] = Field(val, 0);
  18.   buffer.v[1] = Field(val, 1);
  19.   return buffer.d;
  20. }
  21.  
  22. void Store_double_val(val, dbl)
  23.      value val;
  24.      double dbl;
  25. {
  26.   union { value v[2]; double d; } buffer;
  27.  
  28.   Assert(sizeof(double) == 2 * sizeof(value));
  29.   buffer.d = dbl;
  30.   Field(val, 0) = buffer.v[0];
  31.   Field(val, 1) = buffer.v[1];
  32. }
  33.  
  34. #endif
  35.  
  36. value format_float(fmt, arg)    /* ML */
  37.      value fmt, arg;
  38. {
  39.   char format_buffer[64];
  40.   int prec, i;
  41.   char * p;
  42.   char * dest;
  43.   value res;
  44.  
  45.   prec = 64;
  46.   for (p = String_val(fmt); *p != 0; p++) {
  47.     if (*p >= '0' && *p <= '9') {
  48.       i = atoi(p) + 15;
  49.       if (i > prec) prec = i;
  50.       break;
  51.     }
  52.   }
  53.   for( ; *p != 0; p++) {
  54.     if (*p == '.') {
  55.       i = atoi(p+1) + 15;
  56.       if (i > prec) prec = i;
  57.       break;
  58.     }
  59.   }
  60.   if (prec <= sizeof(format_buffer)) {
  61.     dest = format_buffer;
  62.   } else {
  63.     dest = stat_alloc(prec);
  64.   }
  65.   sprintf(dest, String_val(fmt), Double_val(arg));
  66.   res = copy_string(dest);
  67.   if (dest != format_buffer) {
  68.     stat_free(dest);
  69.   }
  70.   return res;
  71. }
  72.  
  73. value float_of_string(s)        /* ML */
  74.      value s;
  75. {
  76.   extern double atof();
  77.   return copy_double(atof(String_val(s)));
  78. }
  79.  
  80. value exp_float(f)              /* ML */
  81.      value f;
  82. {
  83.   return copy_double(exp(Double_val(f)));
  84. }
  85.  
  86. value log_float(f)              /* ML */
  87.      value f;
  88. {
  89.   return copy_double(log(Double_val(f)));
  90. }
  91.  
  92. value sqrt_float(f)             /* ML */
  93.      value f;
  94. {
  95.   return copy_double(sqrt(Double_val(f)));
  96. }
  97.  
  98. value power_float(f, g)         /* ML */
  99.      value f, g;
  100. {
  101.   return copy_double(pow(Double_val(f), Double_val(g)));
  102. }
  103.  
  104. value sin_float(f)              /* ML */
  105.      value f;
  106. {
  107.   return copy_double(sin(Double_val(f)));
  108. }
  109.  
  110. value cos_float(f)              /* ML */
  111.      value f;
  112. {
  113.   return copy_double(cos(Double_val(f)));
  114. }
  115.  
  116. value tan_float(f)              /* ML */
  117.      value f;
  118. {
  119.   return copy_double(tan(Double_val(f)));
  120. }
  121.  
  122. value asin_float(f)             /* ML */
  123.      value f;
  124. {
  125.   return copy_double(asin(Double_val(f)));
  126. }
  127.  
  128. value acos_float(f)             /* ML */
  129.      value f;
  130. {
  131.   return copy_double(acos(Double_val(f)));
  132. }
  133.  
  134. value atan_float(f)             /* ML */
  135.      value f;
  136. {
  137.   return copy_double(atan(Double_val(f)));
  138. }
  139.  
  140. value atan2_float(f, g)        /* ML */
  141.      value f, g;
  142. {
  143.   return copy_double(atan2(Double_val(f), Double_val(g)));
  144. }
  145.